unit FRunEnvt;

interface
uses Windows, SysUtils, Classes, AYConst, ActiveX, ComObj, Variants, Forms,
     Controls, Dialogs, ActnList, IniFiles, ComCtrls,
     Messages, Consts,FUtils;

const
  WM_OLEFORMCOMMAND = WM_USER + 200;


type
  TOleFormCommandType = (ofctCreate, ofctInit, ofctShow, ofctCommand,
                         ofctGetProperties, ofctSetProperties,
                         ofctGetStatusText, ofctSetStatusText,
                         ofctGetTitle, ofctSetTitle,
                         ofctGetCaption, ofctSetCaption,
                         ofctGetTop, ofctGetLeft, ofctGetBottom, ofctGetRight,
                         ofctFindMDI, ofctFreeOleForm,
                         ofctGetRefCount, ofctSetRefCount,
                         ofctGetFreeOnClose, ofctSetFreeOnClose,
                         ofctFindMenu, ofctSysCommand);
  TSysCommandType = (sctBringToFront);
  TFormShowType = (fstClientMDI, fstNormalMDI, fstShowModal, fstShow, fstClientModal, fstMaxMDI);

  TOleVariantStream = class(TMemoryStream)
  private
    FGlobalHandle: HGLOBAL;
    function GetValue: OleVariant;
    procedure SetValue(const Value: OleVariant);
    function ReadVariant: OleVariant;
    procedure WriteVariant(Value: OleVariant);
    function GetGlobalHandle: HGLOBAL;
    procedure SetGlobalHandle(AHandle: HGLOBAL);
  public
    constructor Create;
    destructor Destroy; override;
    property Value: OleVariant read GetValue write SetValue;
    property GlobalHandle: HGLOBAL read GetGlobalHandle write SetGlobalHandle;
  end;

  TMDIOleControlForm = class(TPersistent)
  private
    FParam: String;
    FClassID: TGUID;
    FMainFormHandle: HWND;
    FValueStream: TOleVariantStream;
    FInstanceAllocated: Boolean;
    FFormShowType: TFormShowType;
    function GetProperties(APropertyName: String): OleVariant;
    procedure SetProperties(APropertyName: String; const Value: OleVariant);
    function FindMDI(AParam: String): Boolean;
    function CreateMDI(AParam: String): Boolean;
    function InitMDI(AParam: String): Boolean;
    function GetRefCount: Integer;
    procedure SetRefCount(const Value: Integer);
    function GetFreeOnClose: Boolean;
    procedure SetFreeClose(const Value: Boolean);
  protected
    function InitLibraryForm: Boolean;
    property MainFormHandle: HWND read FMainFormHandle;
    property ValueStream: TOleVariantStream read FValueStream;
    property FormShowType: TFormShowType read FFormShowType write FFormShowType;
    property RefCount: Integer read GetRefCount write SetRefCount;
    property FreeOnClose: Boolean read GetFreeOnClose write SetFreeClose;
  public
    constructor Create(AClassID: TGUID; AParam: String; ANewInstance: Boolean = True);
    destructor Destroy; override;
    procedure CloseOleForm;
    function ExecuteCommand(const ACommandName: WideString; AParams: OleVariant): OleVariant;
    function ShowOleForm(AFormShowType: TFormShowType): TModalResult;
    procedure BringToFront;
    property Properties[APropertyName: String]: OleVariant read GetProperties write SetProperties;
    property ClassID: TGUID read FClassID;
    property Param: String read FParam;
    property InstanceAllocated: Boolean read FInstanceAllocated;
  end;

var
  GV_MainHandle : Integer;
  
implementation

{ TOleVariantStream }

constructor TOleVariantStream.Create;
begin
  inherited Create;
end;

destructor TOleVariantStream.Destroy;
begin
  if FGlobalHandle > 0 then
  begin
    GlobalFree(FGlobalHandle);
  end;
  inherited Destroy;
end;

function TOleVariantStream.GetValue: OleVariant;
var
  i, iArray: Integer;
begin
  if Size > 0 then
  begin
    Position := 0;
    Read(iArray, SizeOf(Integer));
    if iArray >= 0 then
    begin
      Result := VarArrayCreate([0, iArray], varVariant);
      For i := 0 To iArray Do begin
        Result[i] := ReadVariant;
      end;
    end
    else begin
      Result := ReadVariant;
    end;
  end
  else begin
    Result := Null;
  end;
end;

procedure TOleVariantStream.SetValue(const Value: OleVariant);
var
  i, iArray: Integer;
begin
  Clear;
  if Not VarIsNull(Value) then
  begin
    if VarIsArray(Value) then
      iArray := VarArrayHighBound(Value, 1)
    else
      iArray := -1;
    Write(iArray, SizeOf(Integer));
    if iArray >= 0  then
    begin
      For i := 0 To iArray Do begin
        WriteVariant(Value[i]);
      end;
    end
    else begin
      WriteVariant(Value);
    end;
  end;
end;

function TOleVariantStream.ReadVariant: OleVariant;
var
  P: Pointer;
  S: String;
  iLen: Integer;
  M: TMemoryStream;
begin
  With TVarData(Result) Do begin
    Read(VType, SizeOf(Word));
    Case VType Of
      varSmallInt: Read(VSmallInt, SizeOf(SmallInt));
      varInteger:  Read(VInteger, SizeOf(Integer));
      varSingle:   Read(VSingle, SizeOf(Single));
      varDouble:   Read(VDouble, SizeOf(Double));
      varCurrency: Read(VCurrency, SizeOf(Currency));
      varDate:     Read(VDate, SizeOf(TDateTime));
      varOleStr, varString:
        begin
          Read(iLen, SizeOf(Integer));
          SetLength(S, iLen);
          Read(S[1], iLen);
          if VType = varOleStr then
            VOleStr := StringToOleStr(S)
          else
            PString(VString)^ := S;
        end;
      varBoolean:  Read(VBoolean, SizeOf(WordBool));
      varShortInt: Read(VShortInt, SizeOf(ShortInt));
      varByte:     Read(VByte, SizeOf(Byte));
      varWord:     Read(VWord, SizeOf(Word));
      varLongWord: Read(VLongWord, SizeOf(LongWord));
      varInt64:    Read(VInt64, SizeOf(Int64));
      varArray + varByte:
        begin
          M := TMemoryStream.Create;
          Try
            Read(iLen, SizeOf(Integer));
            M.Size := iLen;
            P := M.Memory;
            Read(P^, iLen);
            StreamToByteArray(TVarData(Result), M);
          Finally
            M.Free;
          End;
        end;
      varDispatch: Read(VDispatch, SizeOf(IDispatch));
    End;
  end;
end;

procedure TOleVariantStream.WriteVariant(Value: OleVariant);
var
  P: Pointer;
  S: String;
  iLen: Integer;
  M: TMemoryStream;
begin
  With TVarData(Value) Do begin
    Write(VType, SizeOf(Word));
    Case VType Of
      varSmallInt: Write(VSmallInt, SizeOf(SmallInt));
      varInteger:  Write(VInteger, SizeOf(Integer));
      varSingle:   Write(VSingle, SizeOf(Single));
      varDouble:   Write(VDouble, SizeOf(Double));
      varCurrency: Write(VCurrency, SizeOf(Currency));
      varDate:     Write(VDate, SizeOf(TDateTime));
      varOleStr, varString:
        begin
          if VType = varOleStr then
            S := OleStrToString(VOleStr)
          else
            S := PString(VString)^;
          iLen := Length(S);
          Write(iLen, SizeOf(Integer));
          Write(S[1], iLen);
        end;
      varBoolean:  Write(VBoolean, SizeOf(WordBool));
      varShortInt: Write(VShortInt, SizeOf(ShortInt));
      varByte:     Write(VByte, SizeOf(Byte));
      varWord:     Write(VWord, SizeOf(Word));
      varLongWord: Write(VLongWord, SizeOf(LongWord));
      varInt64:    Write(VInt64, SizeOf(Int64));
      varArray + varByte:
        begin
          M := TMemoryStream.Create;
          Try
            ByteArrayToStream(TVarData(Value), M);
            iLen := M.Size;
            Write(iLen, SizeOf(Integer));
            P := M.Memory;
            Write(P^, iLen);
          Finally
            M.Free;
          End;
        end;
      varDispatch: Write(VDispatch, SizeOf(IDispatch));
    End;
  end;
end;

function TOleVariantStream.GetGlobalHandle: HGLOBAL;
var
  P: PChar;
begin
  if FGlobalHandle > 0 then
    FGlobalHandle := GlobalReAlloc(FGlobalHandle, Size, GMEM_MOVEABLE or GMEM_SHARE)
  else
    FGlobalHandle := GlobalAlloc(GMEM_MOVEABLE or GMEM_SHARE, Size);
  Result := FGlobalHandle;
  P := GlobalLock(Result);
  Try
    if Assigned(P) then
    begin
      Move(Memory^, P^, Size);
    end;
  Finally
    GlobalUnlock(Result);
  End;
end;

procedure TOleVariantStream.SetGlobalHandle(AHandle: HGLOBAL);
var
  P: PChar;
begin
  Clear;
  Size := GlobalSize(AHandle);
  P := GlobalLock(AHandle);
  Try
    if Assigned(P) then
    begin
      Move(P^, Memory^, Size);
    end;
  Finally
    GlobalUnlock(AHandle);
  End;
end;

{ TMDIOleControlForm }

constructor TMDIOleControlForm.Create(AClassID: TGUID; AParam: String; ANewInstance: Boolean = True);
begin
  inherited Create;
  FClassID := AClassID;
  FParam := AParam;
  FInstanceAllocated := False;
  FFormShowType := fstClientMDI;
  FMainFormHandle := GV_MainHandle;

  FValueStream := TOleVariantStream.Create;

  InitLibraryForm;

  if ANewInstance then
  begin
    FInstanceAllocated := FindMDI(Param);
    if Not FInstanceAllocated then
    begin
      FInstanceAllocated := CreateMDI(Param);
      if FInstanceAllocated then
        FInstanceAllocated := InitMDI(Param);
    end;
  end
  else begin
    FInstanceAllocated := FindMDI(Param);
  end;
  if InstanceAllocated then
    RefCount := RefCount + 1;
end;

destructor TMDIOleControlForm.Destroy;
begin
  if InstanceAllocated then
    RefCount := RefCount - 1;
  if (RefCount = 0) and (Not FreeOnClose) then
    CloseOleForm;
  FValueStream.Free;
  inherited Destroy;
end;

function TMDIOleControlForm.InitLibraryForm: Boolean;
begin
  Result := FindMDI(LibraryFormParam);
  if Not Result then
  begin
    Result := CreateMDI(LibraryFormParam);
    if Result then
      Result := InitMDI(LibraryFormParam);
  end;
end;

procedure TMDIOleControlForm.CloseOleForm;
begin
  ValueStream.Value := VarArrayOf([GUIDToString(ClassID), Param]);
  SendMessage(MainFormHandle, WM_OLEFORMCOMMAND,
              Integer(ofctFreeOleForm), ValueStream.GlobalHandle);
end;

function TMDIOleControlForm.FindMDI(AParam: String): Boolean;
begin
  ValueStream.Value := VarArrayOf([GUIDToString(ClassID), AParam]);
  Result := Boolean(SendMessage(MainFormHandle, WM_OLEFORMCOMMAND,
                                Integer(ofctFindMDI), ValueStream.GlobalHandle));
end;

function TMDIOleControlForm.CreateMDI(AParam: String): Boolean;
begin
  ValueStream.Value := VarArrayOf([GUIDToString(ClassID), AParam]);
  Result := Boolean(SendMessage(MainFormHandle, WM_OLEFORMCOMMAND,
                                Integer(ofctCreate), ValueStream.GlobalHandle));
end;

function TMDIOleControlForm.InitMDI(AParam: String): Boolean;
begin
  ValueStream.Value := VarArrayOf([GUIDToString(ClassID), AParam]);
  Result := Boolean(SendMessage(MainFormHandle, WM_OLEFORMCOMMAND,
                                Integer(ofctInit), ValueStream.GlobalHandle));
end;

function TMDIOleControlForm.GetRefCount: Integer;
begin
  ValueStream.Value := VarArrayOf([GUIDToString(ClassID), Param]);
  Result := Integer(SendMessage(MainFormHandle, WM_OLEFORMCOMMAND,
                                Integer(ofctGetRefCount), ValueStream.GlobalHandle));
end;

procedure TMDIOleControlForm.SetRefCount(const Value: Integer);
begin
  ValueStream.Value := VarArrayOf([GUIDToString(ClassID), Param, Value]);
  SendMessage(MainFormHandle, WM_OLEFORMCOMMAND,
              Integer(ofctSetRefCount), ValueStream.GlobalHandle);
end;

function TMDIOleControlForm.ShowOleForm(AFormShowType: TFormShowType): TModalResult;
begin
  FormShowType := AFormShowType;
  ValueStream.Value := VarArrayOf([GUIDToString(ClassID), Param, Integer(AFormShowType)]);
  Result := TModalResult(SendMessage(MainFormHandle, WM_OLEFORMCOMMAND, Integer(ofctShow), ValueStream.GlobalHandle));
end;

function TMDIOleControlForm.GetFreeOnClose: Boolean;
begin
  ValueStream.Value := VarArrayOf([GUIDToString(ClassID), Param]);
  Result := Boolean(SendMessage(MainFormHandle, WM_OLEFORMCOMMAND,
                                Integer(ofctGetFreeOnClose), ValueStream.GlobalHandle));
end;

procedure TMDIOleControlForm.SetFreeClose(const Value: Boolean);
begin
  ValueStream.Value := VarArrayOf([GUIDToString(ClassID), Param, Value]);
  SendMessage(MainFormHandle, WM_OLEFORMCOMMAND,
              Integer(ofctSetFreeOnClose), ValueStream.GlobalHandle);
end;

function TMDIOleControlForm.ExecuteCommand(const ACommandName: WideString; AParams: OleVariant): OleVariant;
var
  V: OleVariant;
  i, iArray: Integer;
begin
  if VarIsArray(AParams) then
  begin
    iArray := VarArrayHighBound(AParams, 1);
    V := VarArrayCreate([0, iArray + 3], varVariant);
    V[0] := GUIDToString(ClassID);
    V[1] := Param;
    V[2] := ACommandName;
    For i := 0 To iArray Do begin
      V[i + 3] := AParams[i];
    end;
    ValueStream.Value := V;
  end
  else begin
    ValueStream.Value := VarArrayOf([GUIDToString(ClassID), Param, ACommandName, AParams]);
  end;
  ValueStream.GlobalHandle := SendMessage(MainFormHandle, WM_OLEFORMCOMMAND,
                                          Integer(ofctCommand), ValueStream.GlobalHandle);
  Result := ValueStream.Value;
end;

procedure TMDIOleControlForm.BringToFront;
begin
  ValueStream.Value := VarArrayOf([GUIDToString(ClassID), Param, sctBringToFront]);
  ValueStream.GlobalHandle := SendMessage(MainFormHandle, WM_OLEFORMCOMMAND,
                                          Integer(ofctSysCommand), ValueStream.GlobalHandle);
end;

function TMDIOleControlForm.GetProperties(APropertyName: String): OleVariant;
begin
  ValueStream.Value := VarArrayOf([GUIDToString(ClassID), Param, APropertyName]);
  ValueStream.GlobalHandle := SendMessage(MainFormHandle, WM_OLEFORMCOMMAND,
                                          Integer(ofctGetProperties), ValueStream.GlobalHandle);
  Result := ValueStream.Value;
end;

procedure TMDIOleControlForm.SetProperties(APropertyName: String; const Value: OleVariant);
begin
  ValueStream.Value := VarArrayOf([GUIDToString(ClassID), Param, APropertyName, Value]);
  SendMessage(MainFormHandle, WM_OLEFORMCOMMAND, Integer(ofctSetProperties), ValueStream.GlobalHandle);
end;

end.
